Visualization and Prediction

Here is the overall pattern of places where pets are found indicated by small red dots so we can focus on dense areas for further analysis. Many pets are found in counties such as San Francisco county and Dallas County.

library(sf)

## Linking to GEOS 3.10.2, GDAL 3.4.2, PROJ 8.2.1; sf_use_s2() is TRUE

Sys.setenv(NOAWT=1)
library(rgdal)

## Loading required package: sp

## Please note that rgdal will be retired by the end of 2023,
## plan transition to sf/stars/terra functions using GDAL and PROJ
## at your earliest convenience.
## 
## rgdal: version: 1.5-30, (SVN revision 1171)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.4.2, released 2022/03/08
## Path to GDAL shared files: /Library/Frameworks/R.framework/Versions/4.2/Resources/library/rgdal/gdal
## GDAL binary built with GEOS: FALSE 
## Loaded PROJ runtime: Rel. 8.2.1, January 1st, 2022, [PJ_VERSION: 821]
## Path to PROJ shared files: /Library/Frameworks/R.framework/Versions/4.2/Resources/library/rgdal/proj
## PROJ CDN enabled: FALSE
## Linking to sp version:1.4-6
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading sp or rgdal.

library(osmdata)

## Data (c) OpenStreetMap contributors, ODbL 1.0. https://www.openstreetmap.org/copyright

library(leafsync)

library(OpenStreetMap)
library(leaflet)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(dbplyr)

## 
## Attaching package: 'dbplyr'

## The following objects are masked from 'package:dplyr':
## 
##     ident, sql

library(readr)
library(mapview)
library(geosphere)
library(jsonlite)
library(leaflet.extras)
library(magrittr)
library(shiny)

## 
## Attaching package: 'shiny'

## The following object is masked from 'package:jsonlite':
## 
##     validate

## The following object is masked from 'package:geosphere':
## 
##     span

setwd("/Users/deevyaswain/Desktop/RTOHack/2017-03-18-county-data") #Import ShapeFile of counties in the United States
counties = readOGR(dsn=".", layer="county-data", stringsAsFactors=F)

## OGR data source with driver: ESRI Shapefile 
## Source: "/Users/deevyaswain/Desktop/RTOHack/2017-03-18-county-data", layer: "county-data"
## with 3233 features
## It has 29 fields
## Integer64 fields read as strings:  URBAN2013 URBAN2006

counties = counties[!(counties$ST %in% c('AK', 'HI', NA)),] #We focus on continental United States
FoundPlaces =read.csv("/Users/deevyaswain/Desktop/RTOHack/merged_data.csv") #Rename merged_data file to my own file name and read it
FoundPlaces = FoundPlaces[!is.na(FoundPlaces$found_lng)&(FoundPlaces$found_lng >= -180),]#From Line 18-22, we clean data
FoundPlaces = FoundPlaces[!is.na(FoundPlaces$found_lat)& (FoundPlaces$found_lat >= -90),]
FoundPlaces = FoundPlaces[!is.na(FoundPlaces$outcome_lng)&(FoundPlaces$outcome_lng >= -180),]
FoundPlaces = FoundPlaces[!is.na(FoundPlaces$outcome_lat)& (FoundPlaces$outcome_lat >= -90),]
FoundPlaces = st_as_sf(FoundPlaces, coords = c("found_lng", "found_lat"), crs = 4326)
upperLeft = c(55, -130)
lowerRight = c(20, -60)
basemap = openmap(upperLeft, lowerRight, type="osm")

## Warning in showSRID(uprojargs, format = "PROJ", multiline = "NO", prefer_proj =
## prefer_proj): Discarded ellps WGS 84 in Proj4 definition: +proj=merc +a=6378137
## +b=6378137 +lat_ts=0 +lon_0=0 +x_0=0 +y_0=0 +k=1 +units=m +nadgrids=@null
## +wktext +no_defs +type=crs

## Warning in showSRID(uprojargs, format = "PROJ", multiline = "NO", prefer_proj =
## prefer_proj): Discarded datum World Geodetic System 1984 in Proj4 definition

plot(basemap)
counties = spTransform(counties, osm())
plot(counties, col="gray", add=T)
plot(st_transform(st_geometry(FoundPlaces), osm()@projargs), pch=19, cex=0.1, col="red2", add=T)

Here we can see the overall cluster of where lost pets where found, when zooming in we see the highest density places per county. This information allows any pet owners to get a gist of areas where pets are most likely found in their area.

#Cluster map

dd_state <- read_csv("/Users/deevyaswain/Desktop/RTOHack/merged_data.csv")

## New names:
## Rows: 23080 Columns: 22
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (6): shelter_id, Species, found_address, outcome_address, justidiction... dbl
## (15): ...1, found_lng, found_lat, outcome_lng, outcome_lat, distance_mi... dttm
## (1): intake_date
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

dd_state_home <- read_csv("/Users/deevyaswain/Desktop/RTOHack/merged_data.csv")

## New names:
## Rows: 23080 Columns: 22
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (6): shelter_id, Species, found_address, outcome_address, justidiction... dbl
## (15): ...1, found_lng, found_lat, outcome_lng, outcome_lat, distance_mi... dttm
## (1): intake_date
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

dd_state<-rename(dd_state,lat=found_lat,lng=found_lng)
dd_state_home<-rename(dd_state_home,lat=outcome_lat,lng=outcome_lng)
info<-paste("<b>Access Type: </b>",dd_state$Type,"<br>",
            "<b>Provider: </b>",dd_state$Provider,"<br>",
            "<b>Location Type: </b>",dd_state$Location_T,sep = "")

## Warning: Unknown or uninitialised column: `Type`.

## Warning: Unknown or uninitialised column: `Provider`.

## Warning: Unknown or uninitialised column: `Location_T`.

pal<-colorFactor(c("lightgreen","green","darkgreen"),dd_state$Type)

## Warning: Unknown or uninitialised column: `Type`.

pal_home<-colorFactor(c("lightblue","blue","darkblue"),dd_state_home$Type)

## Warning: Unknown or uninitialised column: `Type`.

hotspots_map<-dd_state%>%leaflet()%>%addTiles()%>%
    addCircleMarkers(clusterOptions=markerClusterOptions(),
               popup=info,color=pal(dd_state$Type))%>%
    addLegend(labels=c("Low","Medium","High"),colors=c("green","yellow","orange"))

## Warning: Unknown or uninitialised column: `Type`.

## Assuming "lng" and "lat" are longitude and latitude, respectively

## Warning in validateCoords(lng, lat, funcName): Data contains 3114 rows with
## either missing or invalid lat/lon values and will be ignored

hotspots_map

Here we have a close up of two different places, Rochester and Fresno, displaying the found location of lost pets, this allows us to infer the popular regions within the city to look for missing pets.

FoundPlaces_2 =read.csv("/Users/deevyaswain/Desktop/RTOHack/merged_data.csv")
FoundPlaces_2 = FoundPlaces_2[!is.na(FoundPlaces_2$found_lng),]
FoundPlaces_2 = st_as_sf(FoundPlaces_2, coords = c("found_lng", "found_lat"), crs = 4326)
#Rochester
upperLeft = c(43.255424, -77.693695)
lowerRight = c(43.114335, -77.532216)

base_map  = openmap(upperLeft, lowerRight, type="osm")
plot(base_map)
plot(st_transform(st_geometry(FoundPlaces_2), osm()@projargs), pch=19, cex=0.5, col="navy", add=T)

#Fresno
upperLeft = c(37.067647, -120.424343)
lowerRight = c(36.341899,  -119.34994)
base_map  = openmap(upperLeft, lowerRight, type="osm")
plot(base_map)

plot(st_transform(st_geometry(FoundPlaces_2), osm()@projargs), pch=19, cex=0.5, col="navy", add=T)

The following is interactive connection map which indicates visual distance from found address (indicated as blue points)to home address(indicated as dark red points). Owners who lost their pets can enter their addresses and get general ideas of where their pets could go based on connection lines around their home location. In the following maps, we focus on one of dense areas San Francisco County.

#Mapping found locations to home addresses
FoundPlaces =read.csv("/Users/deevyaswain/Desktop/RTOHack/merged_data.csv")
FoundPlaces<- FoundPlaces %>%
  filter(shelter_id=="Oakland")
SFMap<-leaflet(FoundPlaces)%>%
  addTiles() %>% 
  setView(-122.3038691684045, 37.77609453341736, zoom =10) %>% 
  addCircles(lng= FoundPlaces$found_lng,lat = FoundPlaces$found_lat, popup=FoundPlaces$found_address, weight = 3, radius=30, 
                 color="navy", stroke = TRUE, fillOpacity = 0.8) %>% 
  addCircles(lng=FoundPlaces$outcome_lng,lat=FoundPlaces$outcome_lat, popup=FoundPlaces$outcome_address, weight = 3, radius=30, 
                 color="darkred", stroke = TRUE, fillOpacity = 0.8) 

foundsite <- as.matrix(FoundPlaces[,c(4,5)])
home <- as.matrix(FoundPlaces[,c(6,7)])
for(i in 1:nrow(FoundPlaces)){
    SFMap <- addPolylines(SFMap, lat = as.numeric(FoundPlaces[i, c(6, 8)]), 
                               lng = as.numeric(FoundPlaces[i, c(5, 7)]),  color="black",weight=0.8)
}

SFMap

The following we have a heatmap of Rochester and Oakland as examples to show the densest places in the city where pets were found. The Heatmaps provide an overall viewpoint to search for pets without going into details. The generalization helps in mapping the trend of where most pets are found which can help pet owners know the main areas in the city to search for.

#Heat map of Oakland

dd_state_heat <- read_csv("/Users/deevyaswain/Desktop/RTOHack/merged_data.csv")

## New names:
## Rows: 23080 Columns: 22
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (6): shelter_id, Species, found_address, outcome_address, justidiction... dbl
## (15): ...1, found_lng, found_lat, outcome_lng, outcome_lat, distance_mi... dttm
## (1): intake_date
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

dd_state_heat<- dd_state_heat %>%
  filter(shelter_id=="Oakland")
m <- leaflet(dd_state_heat) %>% addProviderTiles(providers$OpenStreetMap) %>%
  setView(-122.1841613, 37.73896, zoom = 10) %>%
  addTiles() %>%
  addHeatmap(lng = dd_state_heat$found_lng, lat = dd_state_heat$found_lat, blur = 40, max = 0.05, radius = 15)
m

#Heat map of Rochester
dd_state_heat_r <- read_csv("/Users/deevyaswain/Desktop/RTOHack/merged_data.csv")

## New names:
## Rows: 23080 Columns: 22
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (6): shelter_id, Species, found_address, outcome_address, justidiction... dbl
## (15): ...1, found_lng, found_lat, outcome_lng, outcome_lat, distance_mi... dttm
## (1): intake_date
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`

dd_state_heat_r<- dd_state_heat_r %>%
  filter(shelter_id=="Rochester")
m <- leaflet(dd_state_heat_r) %>% addProviderTiles(providers$OpenStreetMap) %>%
  setView(-77.693695, 43.255424, zoom = 10) %>%
  addTiles() %>%
  addHeatmap(lng = dd_state_heat_r$found_lng, lat = dd_state_heat_r$found_lat, blur = 40, max = 0.05, radius = 15)
m